Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/cat/uudecode.i

Text File | 1997-10-26 | 8KB | 302 lines

IMPLEMENTATION MODULE UUDecode;

FROM SYSTEM IMPORT CAST, BYTE, ADR, CADR, CALLSYS, ASSEMBLER;

IMPORT FileNames, Strings;

(* CAT-Module *)
IMPORT CatTypes, CatFiles, CatGlobal;

FROM EditTypes IMPORT CAT;

(*$? CAT:
FROM Protokoll IMPORT SendPathUpdate;
*)

(*$? NOT CAT:
FROM FredProtokoll IMPORT SendPathUpdate;
*)

(* Magic-Module *)
IMPORT mtTextfiles;

FROM Void IMPORT v;

CONST   textFiles = TRUE;

TYPE decodeErrType = (noErr, lineToShort, illCharInLine);

CONST offset = 32;

VAR decodePath: CatTypes.String255;
    decodeFile: INTEGER;
    decodeErr : decodeErrType;
    textFile  : mtTextfiles.TEXTFILE;
    lastLine  : ARRAY [0..79] OF CHAR;
    checkLastLine : BOOLEAN;

PROCEDURE BeginDecode();
(* Initialisiert die Dekodierung
 *)
BEGIN
  (* DecodePath setzen *)
  (* Strings.Assign (".\", decodePath, v.bool); *)
  (* DecodeFile zurcksetzen *)
  decodeFile := -1;
  decodeErr := noErr;
  checkLastLine := FALSE;
END BeginDecode;

PROCEDURE iDecodeLine(REF line: ARRAY OF CHAR; validCheck: BOOLEAN): BOOLEAN;
(* Dekodiert eine Zeile
 *)
 VAR lineIndex, byteNum, count, i: INTEGER;
     chars: ARRAY [0..3] OF BYTE;
     hunk: ARRAY [0..2] OF BYTE;
     fname  : CatTypes.String255;
     len    : INTEGER;
     calcLen: INTEGER;
     processLine : BOOLEAN;
     tmp    : ARRAY [0..7] OF CHAR;

  PROCEDURE nextch (): CHAR;

    BEGIN
      INC (lineIndex);
      IF lineIndex > len
      THEN
        RETURN ' '; (* abort('Line too short.'); *)
      END;
      IF NOT (line[lineIndex] IN CatTypes.charSet{0C,' '..'`'})
      THEN
        decodeErr := illCharInLine;
        RETURN 0C; (* abort('Illegal character in line.'); *)
      END;
      IF (line[lineIndex] = '`') OR (line[lineIndex] = 0C)
      THEN
        RETURN ' '
      ELSE
        RETURN line[lineIndex]
      END;
    END nextch;

  PROCEDURE DecodeByte ();

    PROCEDURE GetNextHunk ();

      VAR i: INTEGER;

      BEGIN
        (*$R-*)
        FOR i := 0 TO 3 DO
          chars[i] := SHORT(ORD(nextch()) - offset);
        END;
        ASSEMBLER
          MOVE.L    (A6),A0     ; A0 ist Zeiger auf Variablen von DecodeByte
          MOVE.L    (A0),A0     ; A0 zeigt auf Variablen von DecodeLine
          LEA       chars(A0),A1    ; A1 ist Basisadresse von chars
          LEA       hunk(A0),A2    ; A2 ist Basisadresse von hunk
          MOVE.B    0(A1),D0
          LSL.B     #2,D0       ; chars[0] shl 2
          MOVE.B    1(A1),D1
          MOVE.B    D1,D2       ; chars[1] in D1,D2
          LSR.B     #4,D1       ; chars[1] shr 4
          ADD.B     D1,D0
          MOVE.B    D0,(A2)+
          LSL.B     #4,D2       ; chars[1] shl 4
          MOVE.B    2(A1),D0
          MOVE.B    D0,D1       ; chars[2] in D0,D1
          LSR.B     #2,D0       ; chars[2] shr 2
          ADD.B     D2,D0
          MOVE.B    D0,(A2)+
          LSL.B     #6,D1
          ADD.B     3(A1),D1
          MOVE.B    D1,(A2)
        END;
        (*
        hunk[0] := SHORT(ORD(chars[0]) * 4 + ORD(chars[1]) DIV 16);
        hunk[1] := SHORT(ORD(chars[1]) * 16 + ORD(chars[2]) DIV 4);
        hunk[2] := SHORT(ORD(chars[2]) * 64 + ORD(chars[3]));
        *)
        (*$R=*)
        (*$R- wegen Compiler-Bug*)
        (*
        hunk[0] := (chars[0] shl 2) + (chars[1] shr 4);
        hunk[1] := (chars[1] shl 4) + (chars[2] shr 2);
        hunk[2] := (chars[2] shl 6) + chars[3];
        *)
        byteNum := 0;
      END GetNextHunk;

  BEGIN
    IF byteNum = 3 THEN
      GetNextHunk ();
      IF decodeErr # noErr
      THEN
        RETURN
      END;
    END;
    (*$? NOT textFiles:
    CatFiles.WriteFile (CHAR(hunk[byteNum]), decodeFile);
    *)
    (*$? textFiles:
    mtTextfiles.WriteChar (textFile, CHAR(hunk[byteNum]));
    *)
    INC (byteNum);
  END DecodeByte;

BEGIN
  (* Erstmal feststellen, was fr eine Zeile es ist *)
  len := INTEGER (LENGTH(line));
  IF Strings.Pos ("begin", line, 0) = 0
  THEN
    (* Anfang eines Files *)
    (* Haben wir noch eines offen? Das mssen wir dann zumachen! *)
    IF decodeFile > 0
    THEN
      (* CheckLastLine mssen wir hier nicht machen,
       * vor einem begin kann keine gltige Zeile eines
       * anderen UUs kommen
       *)
      checkLastLine := FALSE;
      (*$? NOT textFiles:
      CatFiles.CloseFile (decodeFile);
      *)
      (*$? textFiles:
      mtTextfiles.CloseTextfile (textFile);
      *)
      decodeFile := -1;
      SendPathUpdate (decodePath);
    END;
    (* Anfang eines Files *)
    (* Dateinamen Suchen *)
    i := Strings.Pos (" ", line, 7);
    IF i < 0 THEN RETURN FALSE END;
    Strings.Copy (line, i+1, len - i - 1, fname, v.bool);
    (* Datei zur Auswahl anbieten *)
    IF CatGlobal.FselGet(decodePath, fname, "*.*", "Decodieren nach", FALSE) THEN
      (* Datei erzeugen *)
      (*$? textFiles:
      Strings.Insert (decodePath, 0, fname, v.bool);
      IF mtTextfiles.OpenTextfile (fname, mtTextfiles.WRITE, 32000, textFile)
      OR mtTextfiles.OpenTextfile (fname, mtTextfiles.WRITE, 512, textFile)
      THEN
        decodeFile := 1;
      END;
      *)
      (*$? NOT textFiles:
      decodeFile := CatFiles.CreateFile (decodePath, fname);
      IF decodeFile < 0
      THEN
        CatFiles.ErrorAlert (decodeFile);
        RETURN FALSE;
      END;
      *)
    END;
  ELSIF Strings.Pos ("end", line, 0) = 0
  THEN
    (* Ende eines Files *)
    IF decodeFile > 0
    THEN
      IF checkLastLine
      THEN
        checkLastLine := FALSE;
        IF ~iDecodeLine (lastLine, FALSE)
        THEN
          RETURN FALSE
        END;
      END;
      (*$? NOT textFiles:
      CatFiles.CloseFile (decodeFile);
      *)
      (*$? textFiles:
      mtTextfiles.CloseTextfile (textFile);
      *)
      decodeFile := -1;
    END;
  ELSE
    IF decodeFile > 0
    THEN
      (* M”glicherweise eine UU-Zeile *)
      lineIndex := -1;
      byteNum := 3;
      count := INTEGER(ORD(nextch()) - offset);
      calcLen := (count DIV 3) * 4;
      IF validCheck & (calcLen = len)
      THEN
        (* Ein Byte fehlt am Ende, L„nge auffllen, die MAUS hat
         * ein Leerzeichen abgebissen
         *)
        INC (len);
      END;
      processLine := ~validCheck OR (calcLen = len - 1) OR (calcLen = len - 2);
      IF len = 1
      THEN
        processLine := FALSE;
      ELSIF ~processLine
      THEN
        (* Zeile noch genauer untersuchen *)
        Strings.Copy (line, 0, 5, tmp, v.bool);
        IF ~Strings.StrEqual (tmp, "-----")      (* definitiv ein Trenner, wenn identisch *)
        THEN
          (* also kein Trenner, mal optimistisch sein *)
          processLine := (len <= 64) & (* Wir nehmen in dem Fall mal an, daž es eine UU-Zeile ist *)
                         (line[0] >= ' ') & (line[0] <= 'R');
        END;
      END;
      IF processLine
      THEN
        IF checkLastLine
        THEN
          checkLastLine := FALSE;
          IF ~iDecodeLine (lastLine, FALSE)
          THEN
            RETURN FALSE
          END;
        END;
        (* wohl UU-Zeile, verarbeiten *)
        FOR i := 0 TO count-1 DO
          DecodeByte ();
          IF decodeErr # noErr
          THEN
            RETURN FALSE
          END;
        END;
      ELSIF ((count DIV 3) * 4 > len) & (len < 80) & (len > 1)
      THEN
        (* m”glicherweise Leerzeichen abgeschnitten *)
        Strings.Assign (line, lastLine, v.bool);
        checkLastLine := TRUE;
      END;
    END;
  END;
  RETURN TRUE;
END iDecodeLine;

PROCEDURE DecodeLine(REF line: ARRAY OF CHAR): BOOLEAN;
BEGIN
  RETURN iDecodeLine (line, TRUE);
END DecodeLine;

PROCEDURE EndDecode ();
(* Beendet die Dekodierung, schliežt ggf. offene Dateien
 *)
BEGIN
  (* Ende eines Files *)
  IF decodeFile > 0
  THEN
    (*$? textFiles:
    mtTextfiles.CloseTextfile (textFile);
    *)
    (*$? NOT textFiles:
    CatFiles.CloseFile (decodeFile);
    *)
    decodeFile := -1;
    SendPathUpdate (decodePath);
  END;
END EndDecode;

BEGIN
  decodePath := "";
END UUDecode.